(* Programme principal *)

open Format
open Lexing
open Lexer
open Parser
open Cub
open Ast

let usage = "usage: m2cub [options] file.m"

let parse_only = ref false
let type_only = ref false

let spec = 
  ["-parse-only", Arg.Set parse_only, "  stops after parsing";
   "-type-only", Arg.Set type_only, "  stops after typing";
  ]

let file =
  let file = ref None in
  let set_file s =
    if not (Filename.check_suffix s ".m") then
    raise (Arg.Bad "no .m extension");
    file := Some s
  in
  Arg.parse spec set_file usage;
  match !file with Some f -> f | None -> Arg.usage spec usage; exit 1

let report_loc (b,e) =
  let l = b.pos_lnum in
  let fc = b.pos_cnum - b.pos_bol + 1 in
  let lc = e.pos_cnum - b.pos_bol + 1 in
  eprintf "File \"%s\", line %d, characters %d-%d:\n" file l fc lc            
let () =
  Printf.printf "Started\n";
  let c = open_in file in
  let lb = Lexing.from_channel c in
  try
    let p = Parser.prog Lexer.token lb in
    close_in c;
    Printf.printf "Parse OK\n";
    if !parse_only then exit 0;
    let p = Pruning.prune_prog p in
    Printf.printf "Prune OK\n";
    if !type_only then exit 0;
    let c = Compile.compile_prog p in
    let output_file = (Filename.chop_suffix file ".m") ^ ".cub" in
    let out = open_out output_file in
    let outf = formatter_of_out_channel out in
    Cub.print_system outf c;
    pp_print_flush outf ();
    close_out out
  with
  | Lexical_error s ->
      report_loc (lexeme_start_p lb, lexeme_end_p lb);
      eprintf "Lexical error : %s\n@." s;
      exit 1
  | Parsing.Parse_error ->
      report_loc (lexeme_start_p lb, lexeme_end_p lb);
      eprintf "Syntax error\n@.";
      exit 1
  | Pruning.Error e ->
      begin match e with
      | Pruning.Unsupported_multdiv ->
          eprintf "Multiply / divide unsupported under Cubicle"
      | Pruning.Variables_addsub ->
          eprintf
            "Adding / substracting two variables unsuppported under Cubicle"
      | Pruning.Array_index ->
          eprintf
            "an index array must be a variable or a record field"
      | Pruning.Undefined_type s ->
	  eprintf "Undefined type : %s\n@." s;
      | Pruning.Undefined_var s ->
	  eprintf "Undefined var : %s\n@." s;
      | _ -> eprintf "Anomaly";
      end;
      exit 1
    (*
      | Typing.Typing_error (d, (s, e)) ->
      report_loc (s, e);
      eprintf "Typing error : %s\n@." d;
      exit 1
    *)
  | e ->
      eprintf "Anomaly: %s\n@." (Printexc.to_string e);
      exit 2

